home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / The World of Computer Software.iso / pcb51a.zip / PCBMAIL.WAS < prev    next >
Text File  |  1992-09-20  |  11KB  |  392 lines
  1. ; PCBMAIL.WAS v.5.1a - 9/20/92 06:40 AM
  2. ; Copyright (c) 1992, Gregg Hommel, All Rights Reserved
  3.  
  4. ; PCBMAIL.WAS is a Windows Aspect script for use with ProComm Plus for
  5. ; Windows, version 1.01. It uses information set through the script,
  6. ; SETMAIL.WAS, to perform semi-automated or automated mail runs on PCBoard
  7. ; systems with Qmail doors.
  8.  
  9. integer status=0, sendrep=0, b1=1, b2=1, b3=1, getmail=0, flag=0
  10. integer secnum = 10, flagbye=0, watchfor, taska, taskb, lang=0, graph=0
  11. string ini = "PCBMAIL.INI", board, door, maildir, defconf, ren_def
  12. string conf, mailcmd, reply, isrep, mailstr, doorcmd, secleft, prompt_str
  13.  
  14. proc main
  15.    string uppath
  16.    set connection statmsg on
  17.    when target 0 "?" call get_prompt
  18.    when target 1 "continue..." call send_ret
  19.    when userexit call done_now
  20.    when cdchanges call done_now
  21.    set dialdir access $DIALENTRY
  22.    read_ini()
  23.  
  24. ; If you have not used SETMAIL to set the parameters which PCBMail needs
  25. ; for a system, all it will do is a simple log on, based on the UserID and
  26. ; Password as set in the dialing directory. PCBMail will warn you that this
  27. ; is the case, log on to the board, then remain running in the background
  28. ; until you log off the board.
  29.  
  30.  
  31.    if null_str(board)
  32.       errormsg "%s is not set up. Logging on only!" $D_NAME
  33.       taskb = 1
  34.       if taska
  35.          watchfor = 0
  36.       endif
  37.       return
  38.    endif
  39.  
  40. ; PCBMail looks in the default upload directory for a REP file for this
  41. ; board. If it finds one, it will automatically upload it to Qmail, and
  42. ; then delete it after the upload.
  43.  
  44.    fetch upldpath uppath
  45.    strfmt reply "%s\%s.REP" uppath board
  46.    if isfile reply
  47.       statmsg "%s.REP exists." board
  48.       sendrep=1
  49.       strfmt isrep "Send %s.REP only" board
  50.    else
  51.       statmsg "No %s.REP to send." board
  52.       strfmt isrep "Skip %s mailrun." board
  53.    endif
  54.    strfmt mailstr "Get new %s mail" board
  55.  
  56. ; Depending on whether you have set up this board to allow joining an
  57. ; alternate conference (if you remain online), PCBMail will present a
  58. ; dialog box where you can set options for this mail run. New to 5.1a is a
  59. ; timer function, which will automatically accept the default dialog
  60. ; settings if you do not make an alternative selection within ten seconds.
  61. ; This will allow you to perform an unattended mail run, if you wish.
  62.  
  63.    strfmt secleft "%d" secnum
  64.    if null_str(defconf)
  65.       alt_dlg_make()
  66.    else
  67.       std_dlg_make()
  68.    endif
  69.    when elapsed 1 call time_up
  70.    when dialog call check_it
  71.    holding()
  72.    statmsg "Log in completed - %s" $D_NAME
  73.    if sendrep || getmail
  74.       strfmt doorcmd "open %s^M" door
  75.       transmit doorcmd
  76.       when target 2 "^xB01" call rep_goes
  77.       when filexfer call check_xfer
  78.       holding()
  79.    elseif flagbye
  80.       transmit mailcmd
  81.    endif
  82.    if not flagbye
  83.       if not null_str(conf)
  84.          transmit conf
  85.          holding()
  86.       endif
  87.       clearwhen target 0
  88.       statmsg "Remaining online with %s." $D_NAME
  89.    endif
  90.    holding()
  91. endproc
  92.  
  93. ; Proc get_prompt is where PCBMail searches the prompts sent by PCBoard or
  94. ; Qmail to locate various key words or phrases. If one of these is found,
  95. ; the appropriate response is sent.
  96.  
  97. proc get_prompt
  98.    termgets $ROW 0 prompt_str $COL
  99.    if chk_prompt("Command")
  100.       if chk_prompt("Qmail")
  101.          send_cmd()
  102.       else
  103.          taska=1
  104.          if taskb
  105.             watchfor=0
  106.          endif
  107.       endif
  108.    elseif chk_prompt("Enter)=yes?") || chk_prompt("More?") || chk_prompt ("Enter = Yes?")
  109.       transmit "N^M"
  110.    elseif chk_prompt("=no change?") && lang==0
  111.          transmit "^M"
  112.          lang++
  113.    elseif chk_prompt("Enter)=no?") || chk_prompt("continue?") || chk_prompt("=none?") || chk_prompt("Enter = No?")
  114.       if chk_prompt("graphics") || chk_prompt("Color?") && graph==0
  115.          transmit "N Q NS^M"
  116.          graph++
  117.       else
  118.          transmit "^M"
  119.       endif
  120.    elseif chk_prompt("Password (Dots")
  121.       transmit $PASSWORD
  122.       transmit "^M"
  123.    elseif chk_prompt("name?")
  124.       transmit $USERID
  125.       transmit " "
  126.       transmit $PASSWORD
  127.       transmit "^M"
  128.    elseif chk_prompt("new user?") || chk_prompt("new caller?")
  129.       transmit "r^M"
  130.    endif
  131. endproc
  132.  
  133. ; Windows Aspect has a limitation on using certain internal functions in
  134. ; if..else conditionals. Several commands such as strfind and nullstr, can
  135. ; only be used once per conditional test. To circumvent this restriction,
  136. ; the next two functions are used.
  137.  
  138. func chk_prompt:integer
  139.    strparm chk_out
  140.    strfind prompt_str chk_out
  141.    return FOUND
  142. endfunc
  143.  
  144. func null_str:integer
  145.    strparm test_var
  146.    integer result
  147.    nullstr test_var result
  148.    return result
  149. endfunc
  150.  
  151. ; Due to the asynchronous nature of some of the commands in Windows Aspect,
  152. ; it may be necessary to, at times, wait for a command to complete before
  153. ; starting on another set. This useful little procedure performs that task.
  154.  
  155. proc holding
  156.    watchfor=1
  157.    while watchfor
  158.    endwhile
  159. endproc
  160.  
  161. proc std_dlg_make
  162.    dialogbox 129 42 127 150 11 "System Options"
  163.       groupbox 10 6 101 45 "Qmail" shadow
  164.       radiobutton 14 20 10 10 "" b1
  165.       radiobutton 14 35 10 10 "" endgroup
  166.       vtext 24 21 85 10 left mailstr
  167.       vtext 24 36 85 10 left isrep
  168.       groupbox 10 58 47 45 "Board" shadow
  169.       radiobutton 15 69 35 10 "Log Off" b2
  170.       radiobutton 15 85 40 10 "Stay On" endgroup
  171.       groupbox 64 58 47 45 "Join" shadow
  172.       radiobutton 68 70 29 10 "Main" b3
  173.       radiobutton 68 85 42 10 "Alternate" endgroup
  174.       text  10 110 70 8 right "Using defaults in "
  175.       vtext 80 110 8 8 center secleft
  176.       text  92 110 16 8 left "secs."
  177.       pushbutton 10 123 102 15 "GO" normal default
  178.    enddialog
  179.    disable ctrl 52
  180. endproc
  181.  
  182. proc alt_dlg_make
  183.    dialogbox 129 42 127 150 11 "System Options"
  184.       groupbox 10 6 101 45 "Qmail" shadow
  185.       radiobutton 14 20 10 10 "" b1
  186.       radiobutton 14 35 10 10 "" endgroup
  187.       vtext 24 21 85 10 left mailstr
  188.       vtext 24 36 85 10 left isrep
  189.       groupbox 38 59 47 45 "Board" shadow
  190.       radiobutton 43 70 35 10 "Log Off" b2
  191.       radiobutton 43 85 40 10 "Stay On" endgroup
  192.       text  10 110 70 8 right "Using defaults in "
  193.       vtext 80 110 8 8 center secleft
  194.       text  92 110 16 8 left "secs."
  195.       pushbutton 10 123 102 15 "GO" normal default
  196.    enddialog
  197. endproc
  198.  
  199. proc check_it
  200.    integer dlgstatus
  201.    clearwhen elapsed
  202.    secleft = $NULLSTR
  203.    updatedlg 64
  204.    dlgstatus = $DIALOG
  205.    while dlgstatus != 10
  206.       if dlgstatus == 51 && b2 == 1
  207.          disable ctrl 52
  208.       elseif dlgstatus == 51 && b2 == 2
  209.          enable ctrl 52
  210.       endif
  211.       return
  212.    endwhile
  213.    set_parms()
  214. endproc
  215.  
  216. proc set_parms
  217.    clearwhen dialog
  218.    if b1 == 1
  219.       getmail = 1
  220.       mailcmd = "D;Y;"
  221.    endif
  222.    if b2 == 1
  223.       strcat mailcmd "G^M"
  224.       flagbye = 1
  225.    else
  226.       strcat mailcmd "Q^M"
  227.       if b3 == 2
  228.          strfmt conf "J %s^M" defconf
  229.       endif
  230.    endif
  231.    taskb = 1
  232.    if taska
  233.       watchfor = 0
  234.    endif
  235. endproc
  236.  
  237. ; This is the procedure which manages the countdown timer used in the
  238. ; dialog box, to control unattended running of the script.
  239.  
  240. proc time_up
  241.    secnum--
  242.    strfmt secleft "%d" secnum
  243.    updatedlg 64
  244.    if secnum == 0
  245.       clearwhen elapsed
  246.       destroydlg
  247.       set_parms()
  248.    endif
  249. endproc
  250.  
  251. ; Proc send_cmd is used to send the appropriate commands to Qmail in order
  252. ; to perform the mail run specified by the dialog box options set.
  253.  
  254. proc send_cmd
  255.    if isfile reply
  256.       transmit "U^M"
  257.    elseif not getmail
  258.       transmit mailcmd
  259.       watchfor -= flagbye
  260.    elseif not flag
  261.       transmit mailcmd
  262.       statmsg "%s is scanning for mail." $D_NAME
  263.       flag = 1
  264.       watchfor -= flagbye
  265.       clearwhen target 2
  266.       when target 2 "PCBoard now" call mail_done
  267.    endif
  268. endproc
  269.  
  270. proc rep_goes
  271.    sendfile ZMODEM reply
  272. endproc
  273.  
  274. ; This procedure does nothing more than monitor the transfer of the mail
  275. ; files. If the transferred file is a REP, it will be deleted after a
  276. ; successful upload.
  277.  
  278. proc check_xfer
  279.    status = $FILEXFER
  280.       while status == 1
  281.          status = $FILEXFER
  282.       endwhile
  283.    if status == 2 
  284.       if isfile reply
  285.          delfile reply
  286.          statmsg "%s.REP sent and deleted." board
  287.       endif
  288.    endif
  289.    status = 0
  290. endproc
  291.  
  292. proc mail_done
  293.    clearwhen filexfer
  294.    clearwhen target 2
  295. endproc
  296.  
  297. proc send_ret
  298.    transmit "^M"
  299. endproc
  300.  
  301. proc read_ini
  302.    profilerd ini $D_NAME "board_ID" board
  303.    profilerd ini $D_NAME "door_ID" door
  304.    profilerd ini $D_NAME "mail_dir" maildir
  305.    profilerd ini $D_NAME "def_conf" defconf
  306.    profilerd ini $D_NAME "rename_as" ren_def
  307. endproc
  308.  
  309. ; Proc ren_qwks is the mail management section of PCBMail. It is here that
  310. ; new mail packets are renamed and moved (if necessary), allowing you to
  311. ; keep several packets without concern about overwriting files, etc.
  312.  
  313. proc ren_qwks
  314.    integer count, test=0, char, char2, max=0, ltr, len
  315.    string newqwk, oldqwk, renqwk, newfile, root, sdate, dldir
  316.    if null_str(ren_def)
  317.       root = board
  318.    else
  319.       substr sdate $DATE 0 5
  320.       strdelete sdate 2 1
  321.       strfmt root "%s%s" board sdate
  322.       strlen root len
  323.       if len > 8
  324.          len -= 8
  325.          strdelete root 4 len
  326.       endif
  327.    endif
  328.    strfmt oldqwk "%s\%s.QW?" maildir root
  329.    if findfirst oldqwk
  330.       max++
  331.       while 1
  332.          if findnext
  333.             max++
  334.          else
  335.             exitwhile
  336.          endif
  337.       endwhile
  338.    endif
  339.    max--
  340.    for count = 0 upto max
  341.       char = 65 + count
  342.       strfmt oldqwk "%s\%s.qw%c" maildir root char
  343.       if findfirst oldqwk
  344.          loopfor
  345.       else
  346.          for test upto 25
  347.             char2 = char + test
  348.             strfmt oldqwk "%s\%s.qw%c" maildir root char2
  349.             if findfirst oldqwk
  350.                strfmt renqwk "%s\%s.qw%c" maildir root char
  351.                rename oldqwk renqwk
  352.                exitfor
  353.             endif
  354.          endfor
  355.       endif
  356.    endfor
  357.    statmsg "Mail directory checked"
  358.    fetch dnldpath dldir
  359.    ltr = max + 65
  360.    for count = -1 upto 9
  361.       if count == -1
  362.          strfmt newfile "%s.QWK" board
  363.       else
  364.          strfmt newfile "%s.QW%d" board count
  365.       endif
  366.       strfmt newqwk "%s\%s" dldir newfile
  367.       if isfile newqwk
  368.            ltr++
  369.          strfmt renqwk "%s\%s.QW%c" maildir root ltr
  370.          rename newqwk renqwk
  371.          if success
  372.             statmsg "%s renamed as %s.QW%c" newfile root ltr
  373.          else
  374.             statmsg "%s not renamed." newfile
  375.          endif
  376.       else
  377.          exitfor
  378.       endif   
  379.    endfor
  380. endproc
  381.  
  382. proc done_now
  383.    if not $CARRIER
  384.       if getmail
  385.          ren_qwks()
  386.       endif
  387.       set connection statmsg off
  388.       exit
  389.    endif
  390. endproc
  391.  
  392.